home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / Source / DBL Pascal Library / INIT Shell Folder / INIT Shell ƒ / Shell ƒ / INITShellLoader.p < prev    next >
Text File  |  1990-06-24  |  12KB  |  409 lines
  1. unit INITShellLoader;
  2. {Copyright © 1990, David B. Lamkins}
  3. {All rights reserved.}
  4.  
  5. interface
  6.  
  7.     uses
  8.         Retrace, SysEqu, INITDoInstall;
  9.  
  10.     procedure main;    {INIT entry point}
  11.  
  12. implementation
  13.  
  14. {•• There is no code here which needs to be modified.}
  15. {•• All of your INIT programming should take place in the INITDoInstall unit.}
  16.  
  17. {This is the main code of the INIT loader.  Variables of main are pseudo-globals for all of}
  18. {its subroutines.}
  19.     procedure main;
  20.         const
  21.             trapNumMask = $1FF;        {low 9 bits of trap opcode contain trap number}
  22.             ResidentType = 'IRES';    {the resource type of patches and VBLs loaded by this INIT}
  23.             loadOK = 128;            {ICN# for "normal successful installation"}
  24.             loadSkipped = 129;        {ICN# for "the INIT was skipped because the mouse button was down"}
  25.             loadFailed = 130;            {ICN# for "something has gone wrong"}
  26.             loadNotDone = 131;        {ICN# for "not loaded due to configuration"}
  27.  
  28.         type
  29.             PatchInfo = record
  30.                     trapOpCode: INTEGER;
  31.                     oldAddress: LONGINT;
  32.                     patchHandle: Handle;
  33.                 end;
  34.             PatchInfoArray = array[1..1] of PatchInfo;
  35.             PatchInfoArrayPtr = ^PatchInfoArray;
  36.             VBLInfo = record
  37.                     queuePtr: QElemPtr;
  38.                     taskHandle: Handle;
  39.                 end;
  40.             VBLInfoArray = array[1..1] of VBLInfo;
  41.             VBLInfoArrayPtr = ^VBLInfoArray;
  42.             QDGlobals = record
  43.                     private: packed array[1..202] of Byte;
  44.                     thePort: GrafPtr;
  45.                 end;
  46.             LongPtr = ^LONGINT;
  47.             InstallState = (OK, Failed, Cancelled);
  48.  
  49.         var
  50.             PatchesInfoPtr: PatchInfoArrayPtr;
  51.             VBLsInfoPtr: VBLInfoArrayPtr;
  52.             NumPatches, NumVBLs: INTEGER;
  53.             MaxPatches, MaxVBLs: INTEGER;
  54.             theState: InstallState;
  55.             EnableIcon: BOOLEAN;
  56.             theINITGlobals: Handle;
  57.             saveA5: LONGINT;
  58.             myPort: GrafPort;
  59.             localQD: QDGlobals;
  60.             localA5: LONGINT;
  61.  
  62. {This procedure is called at patch/VBL installation time to stash the globals handle into the}
  63. {modified code header for the patch/VBL code.  The handle is created by StartInstall.  Additionally,}
  64. {the code header is modified to allow a jump to a patched trap by using SetTrapExit prior to}
  65. {returning from the patch code.}
  66.         procedure SetGlobalPtr (codeAddress: Ptr; trapAddress: LONGINT);
  67.             type
  68.                 CodeHeader = record
  69.                         BSR_instruction: INTEGER;                    {BSR.S *+$10}
  70.                         RTS_instruction: INTEGER;                    {RTS}
  71.                         JMP_opcode: INTEGER;                        {JMP patched_routine}
  72.                         JMP_address: LONGINT;
  73.                         LockCount: INTEGER;                            {number of times globals have been locked}
  74.                         GlobalH: Handle;                                {handle to our globals}
  75.                     end;
  76.                 CodeHeaderPtr = ^CodeHeader;
  77.  
  78.         begin
  79.             with CodeHeaderPtr(codeAddress)^ do
  80.                 begin
  81.                     BSR_instruction := $610E;
  82.                     RTS_instruction := $4E75;
  83.                     JMP_opcode := $4EF9;
  84.                     JMP_address := trapAddress;
  85.                     LockCount := 0;
  86.                     GlobalH := theINITGlobals;
  87.                 end;
  88.         end;
  89.  
  90. {Here is how we remember the things we'll need to undo a trap patch…}
  91.         procedure RememberPatch (h: Handle; trap: INTEGER; originalAddress: LONGINT);
  92.         begin
  93.             numPatches := numPatches + 1;
  94.             if numPatches <= MaxPatches then
  95. {$PUSH}
  96. {$R-}
  97.                 with PatchesInfoPtr^[numPatches] do
  98.                     begin
  99.                         patchHandle := h;
  100.                         trapOpCode := trap;
  101.                         oldAddress := originalAddress;
  102.                     end;
  103. {$POP}
  104.         end;
  105.  
  106. {This corresponds to the previous routine, but for VBL tasks…}
  107.         procedure RememberVBL (h: Handle; q: QElemPtr);
  108.         begin
  109.             NumVBLs := NumVBLs + 1;
  110.             if NumVBLs <= MaxVBLs then
  111. {$PUSH}
  112. {$R-}
  113.                 with VBLsInfoPtr^[NumVBLs] do
  114.                     begin
  115.                         taskHandle := h;
  116.                         queuePtr := q;
  117.                     end;
  118. {$POP}
  119.         end;
  120.  
  121. {This is a pre-initialization to make sure the loader stays sane even if we forget to call}
  122. {DoInstall(initCallback,…).}
  123.         procedure StartInstall;
  124.         begin
  125.             theState := Failed;
  126.             NumPatches := 0;
  127.             MaxPatches := 0;
  128.             PatchesInfoPtr := PatchInfoArrayPtr(NewPtr(0));
  129.             NumVBLs := 0;
  130.             MaxVBLs := 0;
  131.             VBLsInfoPtr := VBLInfoArrayPtr(NewPtr(0));
  132.             theINITGlobals := NewHandleSysClear(0);
  133.         end;
  134.  
  135. {Here is where we initalize the state of the INIT Shell Loader.  Also, we clear the DeskHook}
  136. {and the DragHook per Apple's Tech Note 247.}
  137.         procedure InitInstaller (patchLimit, VBLLimit, sizeOfGlobals: INTEGER);
  138.         begin
  139.             theState := OK;
  140.             EnableIcon := TRUE;
  141.             MaxPatches := patchLimit;
  142.             DisposPtr(Ptr(PatchesInfoPtr));
  143.             PatchesInfoPtr := PatchInfoArrayPtr(NewPtr(SIZEOF(PatchInfo) * MaxPatches));
  144.             MaxVBLs := VBLLimit;
  145.             DisposPtr(Ptr(VBLsInfoPtr));
  146.             VBLsInfoPtr := VBLInfoArrayPtr(NewPtr(SIZEOF(VBLInfo) * MaxVBLs));
  147.             SetHandleSize(theINITGlobals, sizeOfGlobals);
  148.             LongPtr(DeskHook)^ := 0;    {according to TN 247}
  149.             LongPtr(DragHook)^ := 0;    {ditto}
  150.         end;
  151.  
  152. {Before we finish installation, we call this to dispose the pointers used internally.}
  153.         procedure EndInstall;
  154.         begin
  155.             DisposPtr(Ptr(PatchesInfoPtr));
  156.             DisposPtr(Ptr(VBLsInfoPtr));
  157.         end;
  158.  
  159. {If something goes wrong during the installation, we call AbortInstall to unhook all the trap}
  160. {patches and VBL tasks that had been installed by the loader.}
  161.         procedure AbortInstall;
  162.             var
  163.                 i: INTEGER;
  164.                 error: OSErr;
  165.                 theTrapKind: TrapType;
  166.         begin
  167.             for i := 1 to NumVBLs do
  168. {$PUSH}
  169. {$R-}
  170.                 with VBLsInfoPtr^[i] do
  171.                     begin
  172.                         error := VRemove(queuePtr);
  173.                         DisposHandle(taskHandle);
  174.                     end;
  175. {$POP}
  176.             for i := 1 to NumPatches do
  177. {$PUSH}
  178. {$R-}
  179.                 with PatchesInfoPtr^[i] do
  180.                     begin
  181.                         if BTST(trapOpCode, 11) then
  182.                             theTrapKind := ToolTrap
  183.                         else
  184.                             theTrapKind := OSTrap;
  185.                         NSetTrapAddress(oldAddress, BAND(trapNumMask, trapOpCode), theTrapKind);
  186.                         DisposHandle(patchHandle);
  187.                     end;
  188. {$POP}
  189.             DisposHandle(theINITGlobals);
  190.         end;
  191.  
  192. {Here is where we actually install a trap patch.  The patch code is referenced by resource ID}
  193. {(for a resource of type ResidentType, which is normally IRES).  The trap is referenced by}
  194. {its full opcode, not just the number (i.e. _Open = $A000).  Note that if something goes wrong,}
  195. {this fact is reflected in the loader global theState, and future patch installs are automatically}
  196. {skipped.}
  197.         procedure InstallPatch (id, trap: INTEGER);
  198.             var
  199.                 thePatch: Handle;
  200.                 theGlobalsHandle: Handle;
  201.                 theTrapAddress: LONGINT;
  202.                 theTrapKind: TrapType;
  203.  
  204.         begin
  205.             if theState = OK then
  206.                 begin
  207.                     thePatch := GetResource(ResidentType, id);
  208.                     if thePatch <> nil then
  209.                         begin
  210.                             HLock(thePatch);
  211.                             if BTST(trap, 11) then
  212.                                 theTrapKind := ToolTrap
  213.                             else
  214.                                 theTrapKind := OSTrap;
  215.                             theTrapAddress := NGetTrapAddress(trap, theTrapKind);
  216.                             SetGlobalPtr(thePatch^, theTrapAddress);
  217.                             NSetTrapAddress(ORD(thePatch^), BAND(trapNumMask, trap), theTrapKind);
  218.                             DetachResource(thePatch);
  219.                             RememberPatch(thePatch, trap, theTrapAddress);
  220.                         end
  221.                     else
  222.                         theState := Failed;
  223.                 end;
  224.         end;
  225.  
  226. {The installer for VBL tasks is similar to the trap patch installer…}
  227.         procedure InstallVBL (id, count, phase: INTEGER);
  228.             type
  229.                 VBLTaskPtr = ^VBLTask;
  230.             var
  231.                 theTask: Handle;
  232.                 theGlobalsHandle: Handle;
  233.                 theVBLTask: VBLTaskPtr;
  234.                 error: OSErr;
  235.  
  236.         begin
  237.             if theState = OK then
  238.                 begin
  239.                     theTask := GetResource(ResidentType, id);
  240.                     if theTask <> nil then
  241.                         begin
  242.                             HLock(theTask);
  243.                             SetGlobalPtr(theTask^, 0);
  244.                             theVBLTask := VBLTaskPtr(NewPtrSys(SIZEOF(VBLTask)));
  245.                             with theVBLTask^ do
  246.                                 begin
  247.                                     qType := ORD(vType);
  248.                                     vblAddr := theTask^;
  249.                                     vblCount := count;
  250.                                     vblPhase := phase;
  251.                                 end;
  252.                             error := VInstall(QElemPtr(theVBLTask));
  253.                             DetachResource(theTask);
  254.                             RememberVBL(theTask, QElemPtr(theVBLTask));
  255.                         end
  256.                     else
  257.                         theState := Failed;
  258.                 end;
  259.         end;
  260.  
  261. {Simple inline routines to directly manipulate register A5…}
  262.         function RegA5: LONGINT;
  263.         inline
  264.             $2E8D;    {MOVE.L A5,(SP)}
  265.  
  266.         procedure SetA5 (where: Ptr);
  267.         inline
  268.             $2A5F;    {MOVEA.L (SP)+,A5}
  269.  
  270. {Create a Quickdraw world for use by the INIT loader.}
  271.         procedure ConstructQD;
  272.         begin
  273.             saveA5 := RegA5;
  274.             SetA5(@localA5);
  275.             LongPtr(CurrentA5)^ := LONGINT(@localA5);
  276.             InitGraf(@localQD.thePort);
  277.             OpenPort(@myPort);
  278.         end;
  279.  
  280. {Destroy the INIT loader's Quickdraw world.}
  281.         procedure DestructQD;
  282.         begin
  283.             ClosePort(@myPort);
  284.             SetA5(Pointer(saveA5));
  285.             LongPtr(CurrentA5)^ := saveA5;
  286.         end;
  287.  
  288. {Calculate the check value for the INIT icon's horizontal position.}
  289.         function CheckH (n: INTEGER): INTEGER;
  290.         inline
  291.             $301F,                {MOVE.W (SP)+,D0}
  292.             $E358,                {ROL.W #1,D0}
  293.             $0A40, $1021,    {EORI.W #$1021,D0}
  294.             $3E80;                {MOVE.W D0,(SP)}
  295.  
  296. {Plot the INIT's icon in a manner compatible with the standard ShowInit routine.}
  297.         procedure DisplayIcon (id: INTEGER);
  298.             const
  299.                 HOffsetAddr = CurApName + 28;
  300.                 CheckAddr = CurApName + 30;
  301.                 hOffset = 40;
  302.                 vOffset = 40;
  303.                 iconResType = 'ICN#';
  304.  
  305.             type
  306.                 ICN = record
  307.                         data: array[1..32] of LONGINT;
  308.                         mask: array[1..32] of LONGINT;
  309.                     end;
  310.                 ICNPtr = ^ICN;
  311.                 ICNHandle = ^ICNPtr;
  312.                 IntPtr = ^INTEGER;
  313.                 OSTypePtr = ^OSType;
  314.  
  315.             var
  316.                 theIcon: ICNHandle;
  317.                 srcRect, dstRect: Rect;
  318.                 myBitMap: BitMap;
  319.  
  320.         begin
  321.             if EnableIcon then
  322.                 begin
  323.                     theIcon := ICNHandle(GetResource(iconResType, id));
  324.                     if theIcon <> nil then
  325.                         begin
  326.                             HLock(Handle(theIcon));
  327.                             if CheckH(IntPtr(HOffsetAddr)^) <> IntPtr(CheckAddr)^ then
  328.                                 IntPtr(HOffsetAddr)^ := 8;
  329.                             with myPort, dstRect do
  330.                                 begin
  331.                                     top := portRect.bottom - vOffset;
  332.                                     left := IntPtr(HOffsetAddr)^;
  333.                                     bottom := top + 32;
  334.                                     right := left + 32;
  335.                                 end;
  336.                             with myBitMap do
  337.                                 begin
  338.                                     baseAddr := @theIcon^^.mask;
  339.                                     rowBytes := 4;
  340.                                     SetRect(bounds, 0, 0, 32, 32);
  341.                                 end;
  342.                             SetRect(srcRect, 0, 0, 32, 32);
  343.                             CopyBits(myBitMap, myPort.portBits, srcRect, dstRect, srcBic, nil);
  344.                             myBitMap.baseAddr := @theIcon^^.data;
  345.                             CopyBits(myBitMap, myPort.portBits, srcRect, dstRect, srcOr, nil);
  346.                             IntPtr(HOffsetAddr)^ := IntPtr(HOffsetAddr)^ + hOffset;
  347.                             IntPtr(CheckAddr)^ := CheckH(IntPtr(HOffsetAddr)^);
  348.                             ReleaseResource(Handle(theIcon));
  349.                         end;
  350.                 end;
  351.         end;
  352.  
  353. {This is a callback routine.  It is passed as a parameter to the INIT-specific installation}
  354. {routine, DoInstall.  The callback provides a standard way for DoInstall to access routines}
  355. {and globals in the loader unit.}
  356.         procedure InstallCallback (func: callbackCode; param1, param2, param3: INTEGER);
  357.         begin
  358.             case func of
  359.                 initCallback: 
  360.                     InitInstaller(param1, param2, param3);    {maxPatch,maxVBL,globalsSize}
  361.                 setPatch: 
  362.                     InstallPatch(param1, param2);            {resID, trapWord}
  363.                 setVBL: 
  364.                     InstallVBL(param1, param2, param3);    {resID, count, phase}
  365.                 failInstall: 
  366.                     theState := Failed;
  367.                 doNotInstall: 
  368.                     theState := Cancelled;
  369.                 suppressIcon: 
  370.                     EnableIcon := FALSE;
  371.                 otherwise
  372.                     theState := Failed;
  373.             end;
  374.         end;
  375.  
  376. {Here's the main flow of the loader.  Note that the INIT's icon is not displayed until after}
  377. {DoInstall returns, thus allowing the icon to graphically indicate the success or failure of}
  378. {the installation.  Note also that the standard "mouse-button-down" means of skipping the}
  379. {INIT loader is implemented here, and allows for its own distinctive icon.  Finally, note that}
  380. {a valid Quickdraw environment is available during the entire loading process.}
  381.     begin    {main}
  382.         ConstructQD;    {Create a local QuickDraw environment.}
  383.         if Button then
  384.             DisplayIcon(loadSkipped)
  385.         else
  386.             begin
  387.                 StartInstall;
  388.         {The interesting INIT code is all in DoInstall - you write it…}
  389.                 DoInstall(InstallCallback);
  390.         {Upon return, if everthing's OK we display the "normal" icon.}
  391.                 if theState = OK then
  392.                     DisplayIcon(loadOK)
  393.                 else
  394.             {Something went wrong during installation - either a missing resource, or a}
  395.             {program-detected error which was cause to skip or abort loading the INIT.}
  396.                     begin
  397.             {Make sure our patches and VBLs get unhooked, then indicate reason w/icon.}
  398.                         AbortInstall;
  399.                         if theState = Cancelled then
  400.                             DisplayIcon(loadNotDone)
  401.                         else
  402.                             DisplayIcon(loadFailed);
  403.                     end;
  404.                 EndInstall;        {Clean up installer environment.}
  405.             end;
  406.         DestructQD;    {Get rid of our QuickDraw environment.}
  407.     end;
  408.  
  409. end.